home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / SystemCode / strings.tcl < prev    next >
Text File  |  1996-08-15  |  3KB  |  89 lines
  1. #
  2. # strings.tcl (Mark Nagata and Tom Scavo)
  3. #
  4.  
  5. proc setPrefix {} {
  6.     global prefixString
  7.     if {[catch {prompt "New Prefix String:" $prefixString} res] == 1} return
  8.     set prefixString $res
  9. }
  10.  
  11. proc setSuffix {} {
  12.     global suffixString
  13.     if {[catch {prompt "New Suffix String:" $suffixString} res] == 1} return
  14.     set suffixString $res
  15. }
  16.  
  17. proc insertSuffix {} {doSuffix insert}
  18. proc removeSuffix {} {doSuffix remove}
  19. proc doSuffix {which} {
  20.     global suffixString
  21.     set pts [getEndpts]
  22.     set start [lindex $pts 0]
  23.     set end [lindex $pts 1]
  24.     set start [lineStart $start]
  25.     set end [nextLineStart [expr $end-1]]
  26.     set text [getText $start $end]
  27.     set text [doSuffixText $which $suffixString $text]
  28.     replaceText $start $end $text
  29.     select $start [getPos]
  30. }
  31. # Returns a modified text string if the string $text is non-null, 
  32. # and the null string otherwise.  The argument 'operation' is a 
  33. # string directing 'doSuffixText' to either "insert" or "remove" 
  34. # $suffixString to/from each line of $text.
  35. proc doSuffixText {operation suffixString text} {
  36.     if {$text == ""} {return ""}
  37.     set suff [quoteExpr $suffixString]
  38.     if {$operation == "insert"} then {
  39.         set str ${suffixString}¥r
  40.         regsub -all ¥r $text $str text
  41.     } elseif {$operation == "remove"} then {
  42.         set str ${suff}¥r
  43.         regsub -all $str $text ¥r text
  44.     }
  45.     return $text
  46. }
  47.  
  48. proc commentLine {} {insertPrefix}
  49. proc uncommentLine {} {removePrefix}
  50. proc insertPrefix {} {doPrefix insert}
  51. proc removePrefix {} {doPrefix remove}
  52. proc doPrefix {which} {
  53.     global prefixString
  54.     if {[set start [getPos]] == [set end [selEnd]]} {
  55.         set end [nextLineStart $start]
  56.     }
  57.     set start [lineStart $start]
  58.     set text [getText $start $end]
  59.     replaceText $start $end [doPrefixText $which $prefixString $text]
  60.     select $start [getPos]
  61. }
  62. # Returns a modified text string if the string $text is non-null, 
  63. # and the null string otherwise.  The argument 'operation' is a 
  64. # string directing 'doPrefixText' to either "insert" or "remove" 
  65. # $prefixString to/from each line of $text.  See latexEngine.tcl
  66. # for an example.
  67. proc doPrefixText {operation prefixString text} {
  68.     if {$text == ""} {return ""}
  69.     set pref [quoteExpr $prefixString]
  70.     if {$operation == "insert"} then {
  71.         set trailChar ""
  72.         set textLen [string length $text]
  73.         if {[string index $text [expr $textLen-1]] == "¥r"} then {
  74.             set text [string range $text 0 [expr $textLen-2]]
  75.             set trailChar "¥r"
  76.         }
  77.         set str ¥r$prefixString
  78.         regsub -all ¥r $text $str text
  79.         return $prefixString$text$trailChar
  80.     } elseif {$operation == "remove"} then {
  81.         regsub -all ¥r$pref $text ¥r text
  82.         regsub ^$pref $text "" text
  83.         return $text
  84.     }
  85. }
  86.  
  87.  
  88.  
  89.